home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Disk_Activ1987614162006.psc / Disk Activity / frmDiskActivity.frm < prev    next >
Text File  |  2006-04-16  |  22KB  |  589 lines
  1. VERSION 5.00
  2. Begin VB.Form frmDiskActivity 
  3.    BorderStyle     =   1  'Fixed Single
  4.    ClientHeight    =   630
  5.    ClientLeft      =   180
  6.    ClientTop       =   12300
  7.    ClientWidth     =   4725
  8.    ControlBox      =   0   'False
  9.    Icon            =   "frmDiskActivity.frx":0000
  10.    KeyPreview      =   -1  'True
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   42
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   315
  17.    ShowInTaskbar   =   0   'False
  18.    Begin VB.PictureBox picLogo 
  19.       BorderStyle     =   0  'None
  20.       Height          =   480
  21.       Left            =   2160
  22.       Picture         =   "frmDiskActivity.frx":0CCA
  23.       ScaleHeight     =   32
  24.       ScaleMode       =   3  'Pixel
  25.       ScaleWidth      =   32
  26.       TabIndex        =   3
  27.       Top             =   0
  28.       Visible         =   0   'False
  29.       Width           =   480
  30.    End
  31.    Begin VB.PictureBox picTravail 
  32.       Appearance      =   0  'Flat
  33.       AutoRedraw      =   -1  'True
  34.       BackColor       =   &H00FFFFFF&
  35.       BorderStyle     =   0  'None
  36.       ClipControls    =   0   'False
  37.       DrawWidth       =   2
  38.       Enabled         =   0   'False
  39.       FillStyle       =   0  'Solid
  40.       BeginProperty Font 
  41.          Name            =   "Arial"
  42.          Size            =   26.25
  43.          Charset         =   0
  44.          Weight          =   700
  45.          Underline       =   0   'False
  46.          Italic          =   0   'False
  47.          Strikethrough   =   0   'False
  48.       EndProperty
  49.       FontTransparent =   0   'False
  50.       ForeColor       =   &H00FFFFFF&
  51.       Height          =   480
  52.       Left            =   3360
  53.       ScaleHeight     =   32
  54.       ScaleMode       =   3  'Pixel
  55.       ScaleWidth      =   32
  56.       TabIndex        =   2
  57.       TabStop         =   0   'False
  58.       Top             =   0
  59.       Visible         =   0   'False
  60.       Width           =   480
  61.    End
  62.    Begin VB.PictureBox picVide 
  63.       AutoRedraw      =   -1  'True
  64.       BackColor       =   &H00FF00FF&
  65.       BorderStyle     =   0  'None
  66.       FillColor       =   &H00FF00FF&
  67.       ForeColor       =   &H00FF00FF&
  68.       Height          =   480
  69.       Left            =   2760
  70.       Picture         =   "frmDiskActivity.frx":1994
  71.       ScaleHeight     =   32
  72.       ScaleMode       =   3  'Pixel
  73.       ScaleWidth      =   32
  74.       TabIndex        =   1
  75.       TabStop         =   0   'False
  76.       Top             =   0
  77.       Visible         =   0   'False
  78.       Width           =   480
  79.    End
  80.    Begin VB.PictureBox picBase 
  81.       BorderStyle     =   0  'None
  82.       Height          =   480
  83.       Left            =   1560
  84.       Picture         =   "frmDiskActivity.frx":26DE
  85.       ScaleHeight     =   32
  86.       ScaleMode       =   3  'Pixel
  87.       ScaleWidth      =   32
  88.       TabIndex        =   0
  89.       Top             =   0
  90.       Visible         =   0   'False
  91.       Width           =   480
  92.    End
  93.    Begin VB.Timer timerMαJ 
  94.       Enabled         =   0   'False
  95.       Interval        =   400
  96.       Left            =   1080
  97.       Top             =   0
  98.    End
  99.    Begin VB.Label lblDrive 
  100.       AutoSize        =   -1  'True
  101.       Caption         =   "C"
  102.       BeginProperty Font 
  103.          Name            =   "MS Sans Serif"
  104.          Size            =   8.25
  105.          Charset         =   0
  106.          Weight          =   700
  107.          Underline       =   0   'False
  108.          Italic          =   0   'False
  109.          Strikethrough   =   0   'False
  110.       EndProperty
  111.       Height          =   195
  112.       Index           =   0
  113.       Left            =   360
  114.       TabIndex        =   4
  115.       Top             =   143
  116.       Width           =   135
  117.    End
  118.    Begin VB.Image imgDA 
  119.       Height          =   240
  120.       Index           =   0
  121.       Left            =   600
  122.       Stretch         =   -1  'True
  123.       Top             =   120
  124.       Width           =   240
  125.    End
  126.    Begin VB.Menu mnuPrincipal 
  127.       Caption         =   "Codes-Sources"
  128.       Visible         =   0   'False
  129.       Begin VB.Menu mnuMasquer 
  130.          Caption         =   "&Masquer les dΘtails"
  131.       End
  132.       Begin VB.Menu mnuRunAtStartUp 
  133.          Caption         =   "Lancer DiskActivity au dΘmarrage de Windows"
  134.       End
  135.       Begin VB.Menu mnuSΘparateur0 
  136.          Caption         =   "-"
  137.       End
  138.       Begin VB.Menu mnuQuitter 
  139.          Caption         =   "&Quitter"
  140.       End
  141.    End
  142. End
  143. Attribute VB_Name = "frmDiskActivity"
  144. Attribute VB_GlobalNameSpace = False
  145. Attribute VB_Creatable = False
  146. Attribute VB_PredeclaredId = True
  147. Attribute VB_Exposed = False
  148. '=======================================================================================
  149. ' Titre  : DiskActivity
  150. ' Auteur : Jack
  151. ' Source : http://www.vbfrance.com/code.aspx?ID=37086
  152. '=======================================================================================
  153.  
  154.  
  155. Option Explicit
  156.  
  157. ' ## DΘclarations pour assurer le dΘplacement de la forme sans caption α la souris
  158. ' Voir http://www.vbfrance.com/codes/DEPLACER-FEUILLE-SANS-CAPTION_16982.aspx
  159. ' DΘfinition de coordonnΘes d'un objet
  160. Private Type POINTAPI
  161.     x As Long
  162.     y As Long
  163. End Type
  164. ' DΘfinition de position et taille d'un objet
  165. Private Type RECT
  166.     Left As Long
  167.     Top As Long
  168.     Right As Long
  169.     Bottom As Long
  170. End Type
  171.  
  172. ' Pour rΘcupΘrer la position souris (en coordonnΘe Θcran)
  173. Private Declare Function GetCursorPos Lib "user32" ( _
  174.                     lpPoint As POINTAPI) As Long
  175. ' Pour dΘplacer la feuille (en coordonnΘe Θcran)
  176. Private Declare Function MoveWindow Lib "user32" ( _
  177.                     ByVal hWnd As Long, _
  178.                     ByVal x As Long, _
  179.                     ByVal y As Long, _
  180.                     ByVal nWidth As Long, _
  181.                     ByVal nHeight As Long, _
  182.                     ByVal bRepaint As Long) As Long
  183. ' Pour connaεtre la position de la feuille (en coordonnΘe Θcran)
  184. Private Declare Function GetWindowRect Lib "user32" ( _
  185.                     ByVal hWnd As Long, _
  186.                     lpRect As RECT) As Long
  187.  
  188. ' Nos variables de mΘmoire de position
  189. Private DΘplacementEnCours As Boolean
  190. Private Coord              As POINTAPI
  191. Private TailleFeuille      As RECT
  192. '
  193.  
  194. Private Sub Form_Load()
  195.     
  196.     Dim Temp As String, bRet As Boolean
  197.     
  198.     ' Initialisation
  199.     Me.ScaleMode = vbPixels ' facilite la gestion des Images
  200.     Call SetTop(Me, True)   ' Notre forme sera toujours visible
  201.     mnuMasquer.Tag = 0
  202.     mnuRunAtStartUp.Checked = IIf(WillRunAtStartup(App.EXEName) = True, vbChecked, vbUnchecked)
  203.     
  204.     OffSet = 100 / 32 ' DΘcalage de chaque barre du bargraphe sur une base 100% et image de 32 pixels
  205.     picTravail.BackColor = vbMagenta ' DΘfini le fond transparent
  206.     ' Initialisation du tableau des caractΘristiques
  207.     ReDim aDriveList(0)
  208.     ReadMaxOperations = 400    ' valeurs de base pour ne pa que l'affichage
  209.     WriteMaxOperations = 400   '   s'affole les premiΦres minutes
  210.     
  211.     ' RΘcupΦre les paramΦtres enregistrΘs dans la base de registres
  212.     Temp = GetSetting("Codes-Sources", App.EXEName, "Position fenΩtre", CStr(Screen.Width / 2) & ";" & CStr(Screen.Height / 2))
  213.     Me.Move Split(Temp, ";")(0), Split(Temp, ";")(1)
  214.     bRet = GetSetting("Codes-Sources", App.EXEName, "DΘtails masquΘs ?", False)
  215.     If bRet Then mnuMasquer_Click   ' car par dΘfaut, pas cochΘe
  216.     
  217.     ' CrΘe une ic⌠ne dans le SysTray
  218.     PremierCalculNonNull = False
  219.     With TrayIcon
  220.         .cbSize = Len(TrayIcon)             ' make the tray icon
  221.         .hWnd = Me.hWnd                     ' Handle of the window used to handle messages
  222.         .uId = vbNull                       ' ID code of the icon
  223.         .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE ' Flags
  224.         .ucallbackMessage = WM_MOUSEMOVE    ' ID of the call back message
  225.         .hIcon = picLogo.Picture            ' The start icon
  226.         .szTip = "DiskActivity par Jack - Codes Sources" & Chr$(0) ' The Tooltip for the icon
  227.     End With
  228.     ' Add icon to the tray
  229.     Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
  230.     
  231.     ' DΘmarre la procΘdure de hooking pour notre forme pour le MagnΘtisme des formes
  232.     ' ### Si vous voulez faire du debuggage, mettez cette ligne en commentaire
  233.     '     car le hooking empΦche d'accΘder au feuilles de code
  234.     ' Ici, on ne lance pas le hook si on est en mode IDE
  235.     ' ???????????? Je viens de m'apercevoir que ce MagnΘtisme ne fonctionne pas si
  236.     '              la forme n'a pas de Caption - Dommage
  237.     '              En fait, une forme sans Caption ne gΘnΦre pas d'ΘvΦnement WM_ENTERSIZEMOVE
  238.     '              Si vous trouvez une astuce ...
  239.     'DockingStart Me, [Aimantable α toutes les formes du bureau]
  240.     
  241.     ' Recherche tous les disques durs locaux
  242.     Call ListAllDrives
  243.     ' CrΘΘ autant de composant que de disque
  244.     Call CreateComposants
  245.  
  246.     ' On peut lancer la surveillance
  247.     timerMαJ.Enabled = True
  248.     
  249. End Sub
  250.  
  251. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  252.  
  253.     ' Info : Echelle de la forme en Pixels (pas en Twips)
  254.     If (Button And vbRightButton) Then
  255.         PopupMenu mnuPrincipal, vbPopupMenuRightAlign, , , mnuQuitter
  256.     
  257.     ' Si on appuie sur le bouton gauche et
  258.     ' qu'on n'est pas dΘjα en cours de dΘplacement
  259.     ElseIf (Button And vbLeftButton) And Not DΘplacementEnCours Then
  260.         ' On est en train de faire un Double-Click --> Pas de recherche de la position de la forme
  261.         If (x <> WM_LBUTTONDBLCLK) And (Not mnuPrincipal.Visible) Then
  262.             ' On mΘmorise
  263.             DΘplacementEnCours = True
  264.             ' On rΘcupΦre la position initiale de la souris
  265.             Call GetCursorPos(Coord)
  266.             ' et les positions et dimensions initiales de notre feuille
  267.             Call GetWindowRect(Me.hWnd, TailleFeuille)
  268.         End If
  269.     End If
  270.  
  271. End Sub
  272.  
  273. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  274.  
  275.     ' Info : Echelle de la forme en Pixels (pas en Twips)
  276.     Static OccupΘ As Boolean
  277.     
  278.     ' Si on est en cours de dΘplacement avec le bouton gauche
  279.     If (Button And vbLeftButton) And DΘplacementEnCours Then
  280.         ' Dimensionne notre variable souris
  281.         Dim NewCoord As POINTAPI
  282.         ' RΘcupΦre nouvelle position de la souris
  283.         Call GetCursorPos(NewCoord)
  284.         ' DΘplace notre feuille α la nouvelle position
  285.         Call MoveWindow(Me.hWnd, _
  286.                         TailleFeuille.Left + NewCoord.x - Coord.x, _
  287.                         TailleFeuille.Top + NewCoord.y - Coord.y, _
  288.                         TailleFeuille.Right - TailleFeuille.Left, _
  289.                         TailleFeuille.Bottom - TailleFeuille.Top, _
  290.                         True)
  291.         ' Laisse le temps α Windows de gΘrer le graphisme
  292.         DoEvents
  293.         Exit Sub
  294.     End If
  295.         
  296.     ' On fait un Click sur la forme ?
  297.     If OccupΘ = False Then
  298.         OccupΘ = True
  299.         Select Case x
  300.             Case WM_LBUTTONDBLCLK   ' Double-Click gauche
  301.                 mnuMasquer.Tag = -1
  302.                 Call mnuMasquer_Click
  303.             Case WM_RBUTTONUP       ' Click-Droit
  304.                 PopupMenu mnuPrincipal, vbPopupMenuRightAlign, , , mnuMasquer
  305.         End Select
  306.         OccupΘ = False
  307.     End If
  308.     
  309. End Sub
  310.  
  311. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  312.  
  313.     ' Si on relache la souris, on remet α zΘro notre mΘmoire
  314.     If (Button And vbLeftButton) And DΘplacementEnCours Then
  315.             DΘplacementEnCours = False
  316.     End If
  317.  
  318. End Sub
  319.  
  320. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  321.  
  322.     Dim r As Integer
  323.     
  324.     ' Stoppe les scrutations
  325.     timerMαJ.Enabled = False
  326.     
  327.     ' MΘmorise l'emplacement de la fenΩtre pour le prochain redΘmarrage
  328.     ' Les donnΘes sont stockΘes dans la base de registres α cet endroit :
  329.     '   HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Codes-Sources\DiskActivity
  330.     SaveSetting "Codes-Sources", App.EXEName, "Position fenΩtre", CStr(Me.Left) & ";" & CStr(Me.Top)
  331.     SaveSetting "Codes-Sources", App.EXEName, "DΘtails masquΘs ?", Str(mnuMasquer.Tag)
  332.     
  333.     ' Demande de stopper le hooking de notre forme
  334.     DockingTerminate Me
  335.     
  336.     ' DΘtruit les composants chargΘs (sauf l'original)
  337.     For r = lblDrive.Count To 2 Step -1
  338.         Unload lblDrive(r - 1)
  339.     Next r
  340.     For r = imgDA.Count To 2 Step -1
  341.         Unload imgDA(r - 1)
  342.     Next r
  343.     
  344.     ' DΘmonte l'ic⌠ne du Systray
  345.     TrayIcon.cbSize = Len(TrayIcon)
  346.     TrayIcon.hWnd = Me.hWnd
  347.     TrayIcon.uId = vbNull
  348.     Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
  349.     
  350.  
  351. End Sub
  352.  
  353. Private Sub Form_Unload(Cancel As Integer)
  354.     
  355.     Set frmDiskActivity = Nothing
  356.     
  357. End Sub
  358.  
  359. ' DΘplacements quand on clique sur une des Images
  360. Private Sub imgDA_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  361.     ' Renvoie α la feuille les evenements du (seul) controle
  362.     Call Form_MouseDown(Button, Shift, x, y)
  363. End Sub
  364. Private Sub imgDA_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  365.     ' Idem pour les Move
  366.     Call Form_MouseMove(Button, Shift, x, y)
  367. End Sub
  368. Private Sub imgDA_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  369.     ' Idem pour le Up
  370.     Call Form_MouseUp(Button, Shift, x, y)
  371. End Sub
  372.  
  373. ' DΘplacements quand on clique sur un des Labels
  374. Private Sub lblDrive_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  375.     ' Renvoie α la feuille les evenements du (seul) controle
  376.     Call Form_MouseDown(Button, Shift, x, y)
  377. End Sub
  378. Private Sub lblDrive_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  379.     ' Idem pour les Move
  380.     Call Form_MouseMove(Button, Shift, x, y)
  381. End Sub
  382. Private Sub lblDrive_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  383.     ' Idem pour le Up
  384.     Call Form_MouseUp(Button, Shift, x, y)
  385. End Sub
  386.  
  387. Private Sub mnuMasquer_Click()
  388.  
  389.     mnuMasquer.Tag = Not mnuMasquer.Tag
  390.     If mnuMasquer.Tag Then
  391.         Me.Hide
  392.         mnuMasquer.Caption = "&Voir les dΘtails"
  393.     Else
  394.         Me.Show
  395.         Me.WindowState = vbNormal
  396.         mnuMasquer.Caption = "&Masquer les dΘtails"
  397.     End If
  398.         
  399. End Sub
  400.  
  401. Private Sub mnuQuitter_Click()
  402.  
  403.     Unload Me
  404.     
  405. End Sub
  406.  
  407. Private Sub mnuRunAtStartUp_Click()
  408.  
  409.     ' DΘmarrera l'application au dΘmarrage de la session Windows si le menu est cochΘ
  410.     mnuRunAtStartUp.Checked = Not mnuRunAtStartUp.Checked
  411.     If mnuRunAtStartUp.Checked Then
  412.         If Not WillRunAtStartup(App.EXEName) Then
  413.             Call SetRunAtStartup(App.EXEName, App.Path, True)
  414.         End If
  415.     Else
  416.         If WillRunAtStartup(App.EXEName) Then
  417.             Call SetRunAtStartup(App.EXEName, App.Path, False)
  418.         End If
  419.     End If
  420.     
  421. End Sub
  422.  
  423. Private Sub timerMαJ_Timer()
  424.     
  425.     Dim r As Integer
  426.     
  427. '    Debug.Print "-----------------------------"
  428.     ' Recherche les infos d'activitΘ des disques
  429.     For r = 0 To UBound(aDriveList)
  430.         Call ScanDrives(r)
  431.     Next r
  432.     
  433.     ' Fabrique les images
  434.     ' Les disques sont gΘrΘs en sens inverse afin de dΘtecter le 0 = le dernier
  435.     ' Au dernier passage, on crΘe une icone de plus pour le Systray
  436.     For r = UBound(aDriveList) To 0 Step -1
  437.         Call CreateImages(r)
  438.     Next r
  439.     DoEvents
  440.     
  441. End Sub
  442.  
  443.  
  444. Private Sub CreateComposants()
  445.     ' Charge les couples Label-Image pour chaque disque
  446.     ' Rappel : la forme est dimentionnΘe en Pixels, pas en Twips (variables α virgule)
  447.     
  448.     Dim r As Integer
  449.     Dim LargeurCouple As Single
  450.     
  451.     LargeurCouple = lblDrive(0).Width + imgDA(0).Width + 16
  452.     
  453.     ' 1er couple : Composants de base
  454.     lblDrive(0).Caption = Left$(aDriveList(0).DriveName, 1)
  455.     lblDrive(0).Move 2, 5
  456.     imgDA(0).Move lblDrive(0).Left + lblDrive(0).Width + 2, 3
  457.     
  458.     ' les couples suivants
  459.     For r = 1 To UBound(aDriveList)
  460.         ' Si le Label n'existe pas, on le crΘΘ et on le positionne
  461.         If lblDrive.UBound < (r + 1) Then Load lblDrive(r)
  462.         lblDrive(r).Caption = Left$(aDriveList(r).DriveName, 1)
  463.         lblDrive(r).Move lblDrive(r - 1).Left + LargeurCouple, lblDrive(0).Top
  464.         ' Si l'Image n'existe pas, on la crΘΘ et on la positionne
  465.         If imgDA.Count < (r + 1) Then Load imgDA(r)
  466.         imgDA(r).Move lblDrive(r).Left + lblDrive(r).Width + 2, imgDA(0).Top
  467.         ' Rend les deux composants visibles
  468.         lblDrive(r).Visible = True
  469.         imgDA(r).Visible = True
  470.     Next r
  471.     
  472.     ' DΘfinition de la taille de la forme
  473.     Me.Width = (imgDA(imgDA.UBound).Left + imgDA(imgDA.UBound).Width + 8) * Screen.TwipsPerPixelX
  474.     Me.Height = (imgDA(0).Top + imgDA(0).Height + 5) * Screen.TwipsPerPixelY
  475.     Me.Refresh
  476.  
  477. End Sub
  478.  
  479. Private Sub CreateImages(ByVal iDriveIndex As Integer)
  480.     ' GΘnΦre une icone dont les bargraphes repΘsentent l'activitΘ du disque
  481.     '   Voir http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=64964&lngWId=1
  482.     ' iDrive dΘtermine le drive α traiter et gΘnΦre l'image dans imgDA() associΘ
  483.     
  484.     ' Les disques sont scannΘs du dernier vers le premier :
  485.     '   Durant les appels des disques, on a mΘmorisΘ lequel lit et Θcrit le plus
  486.     '   Une fois qu'on sera α l'index 0 (le dernier), on mettra α jour l'ic⌠ne du Systray
  487.     '   pour qu'elle soit l'image de l'activitΘ globale de tous les disques
  488.     
  489.     Static iMaxRead As Integer, iMaxWrite As Integer
  490.     
  491.     Dim hIcon As Long
  492.     Dim IconPic As StdPicture
  493.     
  494.     picTravail.Picture = picBase.Picture ' Image de base
  495.     
  496.     ' DonnΘes c⌠tΘ Lecture
  497.     Call BitBlt(picTravail.hDC, 0, 0, 16, 32 - (aDriveList(iDriveIndex).ReadOperations / OffSet), picVide.hDC, 0, 0, vbSrcCopy)
  498.     ' DonnΘes c⌠tΘ Ecriture
  499.     Call BitBlt(picTravail.hDC, 16, 0, 16, 32 - (aDriveList(iDriveIndex).WriteOperations / OffSet), picVide.hDC, 0, 0, vbSrcCopy)
  500.     ' Redessine l'icone
  501.     picTravail.Picture = picTravail.Image
  502.     
  503.     ' Transforme le Magenta en transparence
  504.     hIcon = BitmapToIcon(picTravail.Picture.handle, vbMagenta)
  505.     Set IconPic = GDIToPicture(hIcon)
  506.     If (IconPic Is Nothing) Then
  507.         ' LibΦre le handle si la crΘation a ΘchouΘ (resources)
  508.         Call DestroyIcon(hIcon)
  509.     Else ' Attribue notre image au composant indexΘ final
  510.         Set imgDA(iDriveIndex) = GDIToPicture(hIcon)
  511.         imgDA(iDriveIndex).ToolTipText = aDriveList(iDriveIndex).DriveName & "  " & _
  512.                                          "Lecture " & CStr(aDriveList(iDriveIndex).ReadOperations) & "%, " & _
  513.                                          "Ecriture " & CStr(aDriveList(iDriveIndex).WriteOperations) & "%"
  514.     End If
  515.  
  516.     ' MΘmorise les Max
  517.     If aDriveList(iDriveIndex).ReadOperations > iMaxRead Then iMaxRead = aDriveList(iDriveIndex).ReadOperations
  518.     If aDriveList(iDriveIndex).WriteOperations > iMaxWrite Then iMaxWrite = aDriveList(iDriveIndex).WriteOperations
  519.     
  520.     ' S'agit-il du dernier disque ?
  521.     If iDriveIndex = 0 Then
  522.         Call CreateSystrayIcon(iMaxRead, iMaxWrite)
  523. 'Debug.Print iMaxRead, iMaxWrite, , ReadMaxOperations, WriteMaxOperations
  524.         ' Remet α zΘro les compteurs
  525.         iMaxRead = 0
  526.         iMaxWrite = 0
  527.         DoEvents
  528.     End If
  529.  
  530. End Sub
  531.  
  532. Private Sub CreateSystrayIcon(ByVal ReadVal As Integer, _
  533.                               ByVal WriteVal As Integer)
  534.  
  535.     ' A peu de chose prΦs, la mΩme procΘdure que dans CreateImages
  536.     
  537.     Static Compteur As Integer
  538.     
  539.     Dim hIcon As Long
  540.     Dim IconPic As StdPicture
  541.     
  542.     picTravail.Picture = picBase.Picture ' Image de base
  543.     
  544.     If ReadVal = 0 And WriteVal = 0 Then
  545.         ' pas d'activitΘ : IncrΘmente le compteur
  546.         Compteur = Compteur + 1
  547.     Else
  548.         ' Sinon, RaZ du compteur
  549.         Compteur = 0
  550.         ' Ca y est, on a des donnΘes α afficher pour la 2ere fois
  551.         PremierCalculNonNull = True
  552.     End If
  553.     If Not PremierCalculNonNull Or Compteur > 5 Then
  554.         ' Plusieurs cycle qu'on n'a pas d'activitΘ --> Affiche le logo
  555.         picTravail.Picture = picLogo.Picture
  556.     Else
  557.         ' DonnΘes c⌠tΘ Lecture
  558.         Call BitBlt(picTravail.hDC, 0, 0, 16, 32 - (ReadVal / OffSet), picVide.hDC, 0, 0, vbSrcCopy)
  559.         ' DonnΘes c⌠tΘ Ecriture
  560.         Call BitBlt(picTravail.hDC, 16, 0, 16, 32 - (WriteVal / OffSet), picVide.hDC, 0, 0, vbSrcCopy)
  561.     End If
  562.     ' Redessine l'icone
  563.     picTravail.Picture = picTravail.Image
  564.     
  565.     ' Transforme le Magenta en transparence
  566.     hIcon = BitmapToIcon(picTravail.Picture.handle, vbMagenta)
  567.     Set IconPic = GDIToPicture(hIcon)
  568.     If (IconPic Is Nothing) Then
  569.         ' LibΦre le handle si la crΘation a ΘchouΘ (resources)
  570.         Call DestroyIcon(hIcon)
  571.     Else ' Attribue notre image α l'ic⌠ne du SysTray
  572.         TrayIcon.hIcon = IconPic.handle
  573.         Shell_NotifyIcon NIM_MODIFY, TrayIcon
  574.     End If
  575.     
  576. End Sub
  577.  
  578. ' Renvoie -1 (True) si on est en mode IDE, ou renvoie 0 (False) sur on est en mode CompilΘ
  579. Private Function InIDE() As Long
  580.     Static Value As Long
  581.     If Value = 0 Then
  582.         Value = 1
  583.         Debug.Assert (True Or InIDE())  ' Cette ligne n'existe pas en mode CompilΘ
  584.         InIDE = Value - 1
  585.     End If
  586.     Value = 0
  587. End Function
  588.  
  589.